home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / dcfftb1.f < prev    next >
Text File  |  1989-08-14  |  2KB  |  71 lines
  1.       subroutine dcfftb1 (n,c,ch,wa,ifac)
  2. c
  3. c     Double precision version.  -tk
  4. c
  5. C***BEGIN PROLOGUE  DCFFTB1
  6. C***REFER TO DCFFTB
  7. C***ROUTINES CALLED  DPASSB,DPASSB5,DPASSB3,DPASSB2,DPASSB4
  8. C***END PROLOGUE  DCFFTB1
  9.       implicit double precision (a-h,o-z)
  10.       dimension       ch(1)      ,c(1)       ,wa(1)      ,ifac(1)
  11. C***FIRST EXECUTABLE STATEMENT  DCFFTB1
  12.       nf = ifac(2)
  13.       na = 0
  14.       l1 = 1
  15.       iw = 1
  16.       do 116 k1=1,nf
  17.          ip = ifac(k1+2)
  18.          l2 = ip*l1
  19.          ido = n/l2
  20.          idot = ido+ido
  21.          idl1 = idot*l1
  22.          if (ip .ne. 4) go to 103
  23.          ix2 = iw+idot
  24.          ix3 = ix2+idot
  25.          if (na .ne. 0) go to 101
  26.          call dpassb4 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3))
  27.          go to 102
  28.   101    call dpassb4 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3))
  29.   102    na = 1-na
  30.          go to 115
  31.   103    if (ip .ne. 2) go to 106
  32.          if (na .ne. 0) go to 104
  33.          call dpassb2 (idot,l1,c,ch,wa(iw))
  34.          go to 105
  35.   104    call dpassb2 (idot,l1,ch,c,wa(iw))
  36.   105    na = 1-na
  37.          go to 115
  38.   106    if (ip .ne. 3) go to 109
  39.          ix2 = iw+idot
  40.          if (na .ne. 0) go to 107
  41.          call dpassb3 (idot,l1,c,ch,wa(iw),wa(ix2))
  42.          go to 108
  43.   107    call dpassb3 (idot,l1,ch,c,wa(iw),wa(ix2))
  44.   108    na = 1-na
  45.          go to 115
  46.   109    if (ip .ne. 5) go to 112
  47.          ix2 = iw+idot
  48.          ix3 = ix2+idot
  49.          ix4 = ix3+idot
  50.          if (na .ne. 0) go to 110
  51.          call dpassb5 (idot,l1,c,ch,wa(iw),wa(ix2),wa(ix3),wa(ix4))
  52.          go to 111
  53.   110    call dpassb5 (idot,l1,ch,c,wa(iw),wa(ix2),wa(ix3),wa(ix4))
  54.   111    na = 1-na
  55.          go to 115
  56.   112    if (na .ne. 0) go to 113
  57.          call dpassb (nac,idot,ip,l1,idl1,c,c,c,ch,ch,wa(iw))
  58.          go to 114
  59.   113    call dpassb (nac,idot,ip,l1,idl1,ch,ch,ch,c,c,wa(iw))
  60.   114    if (nac .ne. 0) na = 1-na
  61.   115    l1 = l2
  62.          iw = iw+(ip-1)*idot
  63.   116 continue
  64.       if (na .eq. 0) return
  65.       n2 = n+n
  66.       do 117 i=1,n2
  67.          c(i) = ch(i)
  68.   117 continue
  69.       return
  70.       end
  71.